#!/usr/bin/env perl

use strict;
use warnings;

use IO::File;
use HTTP::Request;
use HTTP::Headers;
use LWP::UserAgent;
use CGI;

package FormProxy;

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $x = {};
    bless $x => $class;
}

sub post {
    my ($self, $id) = @_;

    my $fp = new IO::File "< ./data/$id" or die "$@: $!";
    my $url = <$fp>;
    my $contenttype = <$fp>;
    my $ref = <$fp>;
    local $/ = undef;
    my $data = <$fp>;

    chomp $url;
    chomp $contenttype;

    my $head = HTTP::Headers->new('Content-type' => $contenttype,
				  'Conent-length' => length $data);
    my $req = HTTP::Request->new("POST", $url, $head, $data);
    my $ua = LWP::UserAgent->new;

    my $res = $ua->request($req);

    if ($res->is_success) {
	rename "./data/$id", "./done/$id";
	my $q = new CGI;
	print
	    $q->header(-type => "text/html;charset=utf-8"),
	    $q->start_html(-encoding => "utf-8", -lang => "ja", -title => "書き込み完了"),
	    $q->h1("書き込み完了"),
	    $q->p("書き込みが完了しました。"),
	    ($ref
	     ? $q->p("右のリンクをクリックして、元のページへお戻りください→ ",
		     $q->a({href => $ref}, "元のページへ"))
	     : $q->p("ブラウザの「戻る」ボタンを2回押して、元のページへお戻りください。")),
	    $q->hr,
	    $q->end_html;
# 	print $res->content;
    } elsif ($res->is_redirect) {
	rename "./data/$id", "./done/$id";
	my $q = new CGI;
	if ($ref) {
	    my $loc = $ref;
	    $loc =~ s|[^/]*$||;
	    $loc .= $res->header('Location');
	    warn "Redirect => $loc";
	    print $q->redirect($loc);
	} else {
	    print
		$q->header(-type => "text/html;charset=utf-8"),
		$q->start_html(-encoding => "utf-8", -lang => "ja", -title => "書き込み完了"),
		$q->h1("書き込み完了"),
		$q->p("書き込みが完了しました。"),
		$q->p("ブラウザの「戻る」ボタンを2回押して、元のページへお戻りください。"),
		$q->hr,
		$q->end_html;
	}
    } else {
	warn "ERROR: ", $res->status_line;
	print CGI::header();
	print "ERROR: ", $res->status_line;
    }
}

sub confirm {
    my ($self, $url) = @_;

    my $contenttype = $ENV{CONTENT_TYPE};
    die "no content-type" unless $contenttype;

    my $ref = $ENV{HTTP_REFERER};
    $ref ||= "";

    if ($url =~ m<^http:/[^/]>) {
	$url =~ s<^http:/><http://>;
    }

    local $/ = undef;
    my $data = <>;

    my $id = $self->gen_id;

    mkdir "./data" || die "$@: $!"
	if (! -d "./data");

    my $fp = new IO::File "> ./data/$id" or die "$@: $!";
    print $fp $url, "\n";
    print $fp $contenttype, "\n";
    print $fp $ref, "\n";
    print $fp $data;

    my $q = new CGI;
    print
	$q->header(-type => "text/html;charset=utf-8"),
	$q->start_html(-encoding => "utf-8", -lang => "ja", -title => "Form confirmation"),
	$q->h1("Form confirmation"),
	$q->start_form(-method => "GET", -action => "/formproxy.cgi/post/$id"),
	$q->p("右の送信ボタンを押してください→", $q->submit(-value => "送信")),
	$q->end_form,
	$q->hr,
# 	$q->p("送信内容は以下の通りです。（よくわからない人は気にしないでください。）"),
# 	$q->pre($q->escapeHTML($data)),
	$q->end_html;
}

sub gen_id {
    time . "." . $$;
}

package main;

&main;

sub main {
    my $pathinfo = $ENV{PATH_INFO};
    my $app = new FormProxy;

    warn $pathinfo;

    if ($pathinfo) {
	my ($cmd, $rest) = $pathinfo =~ m</(.*?)/(.*)$>;

	if ($cmd eq 'post') {
	    $app->post($rest);
	} elsif ($cmd eq 'confirm') {
	    $app->confirm($rest);
	} else {
	    die "invalid pathinfo: $pathinfo";
	}
    } else {
	&app->defalutpage;
    }
}
